home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 041-050 / amok42 / menu / menudemo.mod < prev    next >
Text File  |  1993-11-04  |  8KB  |  282 lines
  1. (*******************************************************************************
  2. :Program.       MenuDemo.mod
  3. :Author.        Jan Behrens
  4. :Address.       Hauptstraße 13, 2211 Holstenniendorf
  5. :Copyright.     PD, siehe Menu.dok
  6. :Language.      Modula-2
  7. :Translator.    M2Amiga
  8. :History.       V1.0 8.Aug.90, Hoffentlich nur wenige Fehler !
  9. :Contents.      Es werden die Fonts in einen Menu dargestellt
  10. *******************************************************************************)
  11.  
  12. MODULE MenuDemo;
  13.  
  14. FROM DiskFont     IMPORT AvailFonts,AvailFontTypes,AvailFontTypeSet,AvailFont,
  15.                          OpenDiskFont;
  16. FROM SYSTEM       IMPORT ADDRESS,ADR,LONGSET;
  17. FROM Exec         IMPORT AllocMem,FreeMem,MemReqs,MemReqSet;
  18. FROM Arts         IMPORT TermProcedure,Assert;
  19. FROM Intuition    IMPORT IntuiText,PrintIText,NewWindow,WindowPtr,OpenWindow,
  20.                          CloseWindow,IDCMPFlags,IDCMPFlagSet,WindowFlags,
  21.                          WindowFlagSet,ScreenFlags,ScreenFlagSet,
  22.                          IntuiTextLength;
  23. FROM Dos          IMPORT Delay;
  24. FROM Graphics     IMPORT jam1,TextAttr,TextFontPtr,RemFont,CloseFont,DrawModes,
  25.                          DrawModeSet;
  26. FROM Menu         IMPORT MenuFlags,MenuFlagSet,MenuType,Menu,DrawMenu;
  27. FROM MouseButtons IMPORT leftMouseButton;
  28.  
  29. CONST NumFonts=100;                  (*Maximale Anzahl der Fonts, die gefunden
  30.                                        werden können*) 
  31.  
  32. TYPE AvailFontHeader=RECORD          (*Record dessen Zeiger von AvailFonts*)
  33.          numEntries:CARDINAL;        (*zurückgegeben wird*)
  34.          af:ARRAY[0..NumFonts-1] OF AvailFont;
  35.        END (*RECORD*);
  36.      AvailFontHeaderPtr=POINTER TO AvailFontHeader;
  37.  
  38. VAR win:NewWindow;
  39.     WPtr:WindowPtr;
  40.     status:LONGINT;
  41.     availPtr:AvailFontHeaderPtr;
  42.     i,selectedFont,CheckSelect,count,NumItems,y:CARDINAL;
  43.     x:INTEGER;
  44.     textFonts:ARRAY[0..NumFonts-1] OF TextFontPtr;   
  45.     intuiText:ARRAY[0..NumFonts-1] OF IntuiText;
  46.     CheckText:ARRAY[0..3]OF IntuiText;
  47.     goonText,HailText,CheckHail:IntuiText;
  48.     menu,CheckMenu:Menu;                   (*Menu-Definition*)
  49.     oneMenu:BOOLEAN;
  50.     string:ARRAY[0..1]OF CHAR;
  51.     CheckiTexte:ARRAY[0..3],[0..10] OF CHAR;
  52.     DModes:DrawModeSet;
  53.           
  54. PROCEDURE CleanUp();
  55.  
  56.   BEGIN
  57.     FOR i:=0 TO availPtr^.numEntries-1 DO
  58.       IF textFonts[i]#NIL THEN
  59.         CloseFont(textFonts[i]);
  60.       END;
  61.       IF textFonts[i]#NIL THEN
  62.         RemFont(textFonts[i]);
  63.       END;
  64.     END;
  65.     IF availPtr#NIL THEN FreeMem(availPtr,SIZE(AvailFontHeader)) END;
  66.     IF WPtr#NIL THEN CloseWindow(WPtr) END;
  67. END CleanUp;
  68.  
  69. BEGIN
  70.   TermProcedure(CleanUp);
  71. (*--Create window--*)
  72.   WITH win DO 
  73.     leftEdge:=0;
  74.     topEdge:=0;
  75.     width:=640;
  76.     height:=256;
  77.     detailPen:=1;
  78.     blockPen:=0;
  79.     idcmpFlags:=IDCMPFlagSet{mouseButtons,rawKey,mouseMove};
  80.     flags:=WindowFlagSet{activate,reportMouse,windowSizing,windowDrag};
  81.     firstGadget:=NIL;
  82.     checkMark:=NIL;
  83.     title:=ADR("   MenuDemo                    © August`90                      Jan Behrens");
  84.     screen:=NIL;
  85.     bitMap:=NIL;
  86.     minWidth:=50;
  87.     minHeight:=50;
  88.     maxWidth:=640;
  89.     maxHeight:=256;
  90.     type:=ScreenFlagSet{wbenchScreen};
  91.   END (*WITH*);
  92.   WPtr:=OpenWindow(win);
  93.   Assert(WPtr#NIL,ADR("Can`t open window..."));
  94.  
  95. (*--Hole verfügbare Fonts--*)  
  96.   availPtr:=AllocMem(SIZE(AvailFontHeader),MemReqSet{memClear});  
  97.   Assert(availPtr#NIL,ADR("No Memory..."));
  98.   status:=AvailFonts(availPtr,SIZE(AvailFontHeader),
  99.                      AvailFontTypeSet{memory,disk});(*Suche Fonts*);
  100.   Assert(status=0,ADR("Speicher war zu klein..."));
  101.  
  102. (*--Open fonts--*)
  103.   FOR i:=0 TO availPtr^.numEntries-1 DO
  104.     IF NOT(memory IN availPtr^.af[i].type) THEN
  105.       textFonts[i]:=OpenDiskFont(ADR(availPtr^.af[i].attr));
  106.     END;
  107.   END (*FOR*);
  108.       
  109.   WITH CheckHail DO                     (*IntuiTexte für Menus mit Daten*) 
  110.     frontPen:=2;                        (*füllen*)
  111.     backPen:=0;
  112.     drawMode:=DrawModeSet{inversvid};
  113.     leftEdge:=5;
  114.     topEdge:=3;
  115.     iText:=ADR("Welche DrawModes ?");
  116.     iTextFont:=NIL;
  117.     nextText:=NIL;
  118.   END (*WITH*);
  119.  
  120.   FOR i:=0 TO 3 DO
  121.     WITH CheckText[i] DO
  122.       frontPen:=1;
  123.       backPen:=0;
  124.       drawMode:=jam1;
  125.       leftEdge:=5;
  126.       topEdge:=16+i*13;
  127.       iText:=ADR(CheckiTexte[i]);
  128.       iTextFont:=NIL;
  129.       IF i#3 THEN
  130.         nextText:=ADR(CheckText[i+1]);
  131.       ELSE
  132.         nextText:=NIL;
  133.       END (*IF*);
  134.     END (*WITH*);
  135.   END (*FOR*);
  136.   CheckiTexte[0]:="dm0";
  137.   CheckiTexte[1]:="complement";
  138.   CheckiTexte[2]:="inversvid";
  139.   CheckiTexte[3]:="---ENDE---";
  140.  
  141.   WITH CheckMenu DO                   (*Ein Check-Menu mit Daten füllen*)
  142.     leftEdge:=243;
  143.     topEdge:=94;
  144.     width:=154;
  145.     height:=68;
  146.     type:=checkMenu;
  147.     flags:=MenuFlagSet{borderItems,menuBorder,standardWidth};
  148.     numItems:=4;
  149.     selectedItems:=LONGSET{};
  150.     checkMark:=NIL;
  151.     standWidth:=82;
  152.     hailText:=ADR(CheckHail);
  153.     firstText:=ADR(CheckText[0]);
  154.   END;
  155.  
  156.   WITH goonText DO
  157.     frontPen:=2;
  158.     backPen:=0;
  159.     drawMode:=jam1;
  160.     leftEdge:=5;
  161.     iTextFont:=NIL;
  162.     nextText:=NIL;
  163.   END (*WITH*);
  164.   
  165.   WITH HailText DO
  166.     frontPen:=2;
  167.     backPen:=0;
  168.     drawMode:=DrawModeSet{inversvid};
  169.     leftEdge:=5;
  170.     topEdge:=3;
  171.     iText:=ADR("Such dir einen Font aus :");
  172.     iTextFont:=NIL;
  173.     nextText:=NIL;
  174.   END (*WITH*);
  175.   
  176.   oneMenu:=TRUE;
  177.   LOOP
  178.     y:=16;
  179.     count:=0;
  180.     x:=IntuiTextLength(ADR(HailText));
  181.     FOR i:=0 TO availPtr^.numEntries DO
  182.       IF (y+availPtr^.af[i].attr.ySize+13<236) AND (i#availPtr^.numEntries) THEN
  183.         WITH intuiText[count] DO
  184.           frontPen:=1;
  185.           backPen:=0;
  186.           drawMode:=jam1;
  187.           leftEdge:=5;
  188.           topEdge:=y;
  189.           iTextFont:=ADR(availPtr^.af[i].attr);
  190.           iText:=availPtr^.af[i].attr.name;
  191.           nextText:=ADR(intuiText[count+1]);
  192.         END;
  193.         IF (IntuiTextLength(ADR(intuiText[count])) > x) THEN
  194.           x:=IntuiTextLength(ADR(intuiText[count]));
  195.         END (*IF*);
  196.         y:=y+3+availPtr^.af[i].attr.ySize;
  197.         INC(count);
  198.       ELSE
  199.         goonText.topEdge:=y;
  200.         IF (i=availPtr^.numEntries) THEN
  201.           IF oneMenu THEN
  202.             intuiText[count-1].nextText:=NIL;
  203.             NumItems:=count;
  204.           ELSE  
  205.             intuiText[count-1].nextText:=ADR(goonText);
  206.             goonText.iText:=ADR("Erste Fonts noch einmal");
  207.             NumItems:=count+1;
  208.             IF x<184 THEN
  209.               x:=184;
  210.             END;
  211.             y:=y+13;
  212.           END (*IF*);
  213.         ELSE
  214.           intuiText[count-1].nextText:=ADR(goonText);
  215.           goonText.iText:=ADR("Weitere Fonts");
  216.           NumItems:=count+1;
  217.           IF x<104 THEN
  218.             x:=104;
  219.           END;
  220.           y:=y+13;
  221.         END (*IF*);           
  222.         WITH menu DO
  223.           leftEdge:=(640-x) DIV 2;
  224.           topEdge:=(256-y) DIV 2;
  225.           width:=x+10;
  226.           height:=y;
  227.           type:=selectMenu;
  228.           flags:=MenuFlagSet{invertItems,menuBorder};
  229.           numItems:=NumItems;
  230.           selectedItems:=LONGSET{};
  231.           checkMark:=NIL;
  232.           standWidth:=0;
  233.           hailText:=ADR(HailText);
  234.           firstText:=ADR(intuiText[0]);
  235.         END;                    
  236.         selectedFont:=DrawMenu(WPtr,ADR(menu));
  237.         Delay(5);
  238.         IF selectedFont#count THEN
  239.           EXIT
  240.         ELSE
  241.           y:=16;
  242.           count:=0;
  243.           oneMenu:=FALSE;
  244.           x:=IntuiTextLength(ADR(HailText));
  245.         END (*IF*);
  246.       END (*IF*);
  247.     END (*FOR*);
  248.   END (*LOOP*);
  249.  
  250.   CheckSelect:=DrawMenu(WPtr,ADR(CheckMenu));
  251.   FOR i:=1 TO 3 DO
  252.     IF i IN CheckMenu.selectedItems THEN
  253.       INCL(DModes,VAL(DrawModes,i));
  254.     END (*IF*);
  255.   END (*FOR*); 
  256. (*--DoAction--*)
  257.   y:=10;
  258.   x:=0;
  259.   string[1]:=0C;
  260.   intuiText[selectedFont].iText:=ADR(string);
  261.   intuiText[selectedFont].drawMode:=DModes;
  262.   intuiText[selectedFont].nextText:=NIL;
  263.   intuiText[selectedFont].topEdge:=0;
  264.   intuiText[selectedFont].leftEdge:=0;
  265.   LOOP
  266.     FOR i:=32 TO 255 DO
  267.       IF x>640 THEN
  268.         INC(y,intuiText[selectedFont].iTextFont^.ySize);
  269.         x:=0;
  270.       END (*IF*);
  271.       IF y>256 THEN
  272.         EXIT
  273.       END;
  274.       string[0]:=CHR(i);
  275.       PrintIText(WPtr^.rPort,ADR(intuiText[selectedFont]),x,y);
  276.       INC(x,IntuiTextLength(ADR(intuiText[selectedFont])));
  277.     END (*FOR*);
  278.   END (*LOOP*);      
  279.  
  280.   REPEAT UNTIL leftMouseButton();
  281. END MenuDemo. 
  282.